home *** CD-ROM | disk | FTP | other *** search
/ Ham Radio 2000 #1 / Ham Radio 2000.iso / ham2000 / packet / p_aa4re / bb212src / bbminit.pas < prev    next >
Encoding:
Pascal/Delphi Source File  |  1992-02-16  |  21.1 KB  |  601 lines
  1. (*===========================================================================*)
  2. (* Procedure for initializing messages                                       *)
  3. (*                                                                           *)
  4. (*   Copyright 1988, 1989, 1990, 1991 by H. Roy Engehausen.  All rights      *)
  5. (*   reserved.                                                               *)
  6. (*                                                                           *)
  7. (*===========================================================================*)
  8.  
  9. {$DEFINE POINT_CHK}
  10. {$DEFINE FREE_CHK}
  11. {$UNDEF  DEBUG_L1} (* Debug language area 1 -- File names *)
  12. {$UNDEF  DEBUG_2}  (* Debug error handling *)
  13.  
  14. {$O+} {This procedure gets overlayed}
  15.  
  16. UNIT BBMINIT;
  17.  
  18. INTERFACE
  19.  
  20. PROCEDURE message_init(error_abort : BOOLEAN);
  21. PROCEDURE message_reload;
  22.  
  23. IMPLEMENTATION
  24.  
  25.   USES
  26.     CRT,
  27.     bbdummy,
  28.     bbmdata,
  29.     bbmess,
  30.     bbmisc2,
  31.     bbmisc3,
  32.     bbsdata,
  33.     bbsema2,
  34.     bbstr,
  35.     bbtask,
  36.     bbtime,
  37.     bbwin;
  38.  
  39. (*===========================================================================*)
  40. (* Add message queue  -- Add something to the message queue                  *)
  41. (*===========================================================================*)
  42.  
  43. PROCEDURE add_message_q(VAR message_q : qe_ptr;
  44.                           file_qe : BOOLEAN;
  45.                           data_qe : string);
  46.  
  47.   VAR
  48.     i       : WORD;
  49.     old_qe  : qe_ptr;
  50.     work_qe : qe_ptr;
  51.  
  52.   BEGIN;
  53.  
  54.     (*-----------------------------------------------------------------------*)
  55.     (* Build a queue element with the data in it.                            *)
  56.     (*-----------------------------------------------------------------------*)
  57.  
  58.     i := WORD(qe_overhead) + LENGTH(data_qe);
  59.  
  60.     GETMEM(work_qe, i);
  61.  
  62.     WITH work_qe^ DO
  63.       BEGIN;
  64.         qe_next      := NIL;
  65.         qe_file_type := file_qe;
  66.         i := 1 + LENGTH(data_qe);
  67.         MOVE(data_qe, qe_data, i);
  68.       END;
  69.  
  70.     (*-----------------------------------------------------------------------*)
  71.     (* If the head of the queue is empty, hang it on the head else           *)
  72.     (* hang it off the tail                                                  *)
  73.     (*-----------------------------------------------------------------------*)
  74.  
  75.     IF message_q = NIL THEN
  76.       message_q := work_qe
  77.     ELSE
  78.       BEGIN;
  79.  
  80.         old_qe := message_q;
  81.  
  82.         WHILE old_qe^.qe_next <> NIL DO
  83.           BEGIN;
  84.  
  85.             {$IFDEF POINT_CHK}
  86.               test_pointer(old_qe);
  87.             {$ENDIF}
  88.  
  89.             old_qe := old_qe^.qe_next;
  90.  
  91.           END;
  92.  
  93.         old_qe^.qe_next := work_qe;
  94.  
  95.       END;
  96.  
  97.   END;
  98.  
  99. (*===========================================================================*)
  100. (* Message init                                                              *)
  101. (*===========================================================================*)
  102.  
  103. PROCEDURE message_init(error_abort : BOOLEAN);
  104.  
  105.   VAR
  106.     error_sw   : BOOLEAN;
  107.     i          : BYTE;
  108.     j          : user_class_type;
  109.     code       : INTEGER;
  110.     line_cnt   : WORD;
  111.     message_no : INTEGER;
  112.  
  113.   (*=========================================================================*)
  114.   (* Sub procedure to send error messages                                    *)
  115.   (*=========================================================================*)
  116.  
  117.   PROCEDURE send_err_mess(mess : STRING);
  118.     BEGIN;
  119.  
  120.       {$IFDEF DEBUG_2}
  121.         WRITELN('Error handler -- ', mess);
  122.         test_pointer(active_tcb);
  123.         WRITELN('TCB type -- ', ORD(active_tcb^.tcb_type));
  124.       {$ENDIF}
  125.  
  126.       IF active_tcb^.tcb_type = th_main THEN
  127.         WRITELN(mess)
  128.       ELSE
  129.         send_tnc_data_str(mess + cr);
  130.       active_tcb^.error_sw := TRUE;
  131.       error_sw := TRUE;
  132.     END;
  133.  
  134.   (*=========================================================================*)
  135.   (* Sub procedure to process one message file                               *)
  136.   (*=========================================================================*)
  137.  
  138.   PROCEDURE message_file_process(lang_char : CHAR; lang_num : BYTE);
  139.  
  140.     VAR
  141.       i          : BYTE;
  142.       in_str     : STRING;
  143.       mess_file  : TEXT;
  144.       mess_head  : mess_list_ptr;
  145.       mess_old   : mess_list_ptr;
  146.       mess_work  : mess_list_ptr;
  147.       s          : STRING[5];
  148.       uc         : user_class_type;
  149.  
  150.     LABEL
  151.       read_loop;
  152.  
  153.     BEGIN;
  154.  
  155.       (*---------------------------------------------------------------------*)
  156.       (* Assign name                                                         *)
  157.       (*---------------------------------------------------------------------*)
  158.  
  159.       in_str := opt_block.mess_fn + lang_char;
  160.  
  161.       ASSIGN(mess_file, in_str);
  162.  
  163.       (*---------------------------------------------------------------------*)
  164.       (* Open                                                                *)
  165.       (*---------------------------------------------------------------------*)
  166.  
  167.       {$I-}
  168.       RESET(mess_file);
  169.       {$I+}
  170.       i := IORESULT;
  171.  
  172.       IF i <> 0 THEN
  173.         BEGIN;
  174.           STR(i, s);
  175.           send_err_mess('**** MESSAGE FILE (' + in_str
  176.                         + ') not found -- Dos error = ' + s);
  177.           EXIT;
  178.         END;
  179.  
  180.       (*---------------------------------------------------------------------*)
  181.       (* Get ready to process file                                           *)
  182.       (*---------------------------------------------------------------------*)
  183.  
  184.       error_sw   := FALSE;
  185.       line_cnt   := 0;
  186.       message_no := 0;
  187.       mess_head  := NIL;
  188.  
  189.       (*---------------------------------------------------------------------*)
  190.       (* Loop thru file                                                      *)
  191.       (*---------------------------------------------------------------------*)
  192.  
  193.   read_loop:
  194.  
  195.       WHILE NOT EOF(mess_file) DO
  196.         BEGIN;
  197.  
  198.           (*-----------------------------------------------------------------*)
  199.           (* Read a line and count it                                        *)
  200.           (*-----------------------------------------------------------------*)
  201.  
  202.           READLN(mess_file, in_str);
  203.  
  204.           line_cnt := line_cnt + 1;
  205.  
  206.           (*-----------------------------------------------------------------*)
  207.           (* Skip blanks and comments                                        *)
  208.           (*-----------------------------------------------------------------*)
  209.  
  210.           IF in_str = '' THEN
  211.             GOTO read_loop;
  212.  
  213.           code := 1;
  214.           WHILE (code <= LENGTH(in_str)) DO
  215.             CASE in_str[code] OF
  216.               ';' : GOTO read_loop;
  217.               ' ' : INC(code);
  218.               ELSE
  219.                 code := 256;
  220.             END;
  221.  
  222.           (*-----------------------------------------------------------------*)
  223.           (* See it if is a header                                           *)
  224.           (*-----------------------------------------------------------------*)
  225.  
  226.           IF (LENGTH(in_str) > 2) AND (in_str[1] = ':') THEN
  227.             BEGIN;
  228.  
  229.               (*-------------------------------------------------------------*)
  230.               (* See it if is a header even more                             *)
  231.               (*-------------------------------------------------------------*)
  232.  
  233.               IF (WORDS(in_str) = 3) AND (in_str[2] = ' ') THEN
  234.                 BEGIN;
  235.  
  236.                   (*---------------------------------------------------------*)
  237.                   (* Process message number                                  *)
  238.                   (*---------------------------------------------------------*)
  239.  
  240.                   VAL(subword(@in_str, 2, 1), message_no, code);
  241.  
  242.                   {$IFDEF DEBUG_2}
  243.                     WRITELN('Number text = ', subword(@in_str, 2, 1));
  244.                     WRITELN('Message number -- ', message_no, '/', code);
  245.                   {$ENDIF}
  246.  
  247.                   IF (code <> 0) OR (message_no < 1) OR
  248.                                                (message_no > max_message) THEN
  249.                     BEGIN;
  250.                       STR(line_cnt, s);
  251.                       send_err_mess(
  252.                         'Error in message file -- Bad message # -- line # '
  253.                         + s);
  254.                       message_no := 0;
  255.                       GOTO read_loop;
  256.                     END;
  257.  
  258.                   (*---------------------------------------------------------*)
  259.                   (* Process type                                            *)
  260.                   (*---------------------------------------------------------*)
  261.  
  262.                   in_str := subword(@in_str, 3, 1);
  263.  
  264.                   IF LENGTH(in_str) <> 1 THEN
  265.                     BEGIN;
  266.                       STR(line_cnt, s);
  267.                       send_err_mess(
  268.                         'Error in message file -- Bad user class -- line # '
  269.                         + s);
  270.                       GOTO read_loop;
  271.                     END;
  272.  
  273.                   CASE UPCASE(in_str[1]) OF
  274.                     'N' : uc := user_c_nu;
  275.                     'U' : uc := user_c_uu;
  276.                     'O' : uc := user_c_ou;
  277.                     'E' : uc := user_c_eu;
  278.                     'B' : uc := user_c_bu;
  279.                     'R' : uc := user_c_rsu;
  280.                     'L' : uc := user_c_lsu;
  281.                     ELSE
  282.                       BEGIN;
  283.                         STR(line_cnt, s);
  284.                         send_err_mess(
  285.                           'Error in message file -- Bad user class -- line # '
  286.                           + s);
  287.                         GOTO read_loop;
  288.                       END;
  289.                   END;
  290.  
  291.                   (*---------------------------------------------------------*)
  292.                   (* Allocate the message                                    *)
  293.                   (*---------------------------------------------------------*)
  294.  
  295.                   NEW(mess_head);
  296.                   WITH mess_head^ DO
  297.                     BEGIN;
  298.                       mess_next  := NIL;
  299.                       mess_this  := NIL;
  300.                       mess_lang  := lang_num;
  301.                       mess_class := uc;
  302.                     END;
  303.  
  304.                   (*---------------------------------------------------------*)
  305.                   (* Get head of chain                                       *)
  306.                   (*---------------------------------------------------------*)
  307.  
  308.                   mess_work := message_array[message_no];
  309.  
  310.                   {$IFDEF POINT_CHK}
  311.                     IF mess_work <> NIL THEN
  312.                       test_pointer(mess_work);
  313.                   {$ENDIF}
  314.  
  315.                   (*---------------------------------------------------------*)
  316.                   (* Look for insertion point                                *)
  317.                   (*---------------------------------------------------------*)
  318.  
  319.                   IF (mess_work = NIL)
  320.                        OR (mess_work^.mess_class < uc)
  321.                        OR ((mess_work^.mess_class = uc)
  322.                                     AND (mess_work^.mess_lang < lang_num)) THEN
  323.                     BEGIN;
  324.  
  325.                       (*-----------------------------------------------------*)
  326.                       (* Insert at head of chain                             *)
  327.                       (*-----------------------------------------------------*)
  328.  
  329.                       message_array[message_no] := mess_head;
  330.                       mess_head^.mess_next := mess_work;
  331.                     END
  332.                   ELSE
  333.                     BEGIN;
  334.  
  335.                       (*-----------------------------------------------------*)
  336.                       (* Search chain for insertion point                    *)
  337.                       (*-----------------------------------------------------*)
  338.  
  339.                       REPEAT
  340.  
  341.                         {$IFDEF POINT_CHK}
  342.                           test_pointer(mess_work);
  343.                         {$ENDIF}
  344.  
  345.                         mess_old  := mess_work;
  346.                         mess_work := mess_work^.mess_next;
  347.  
  348.                         {$IFDEF DEBUG_L1}
  349.                           IF message_no = 4 THEN
  350.                             BEGIN;
  351.                               WRITELN('Test -- ', ORD(mess_work^.mess_class),
  352.                                           ' -- ', mess_work^.mess_lang);
  353.                               WRITELN(mess_work^.mess_class < uc, ' ',
  354.                                           (mess_work^.mess_class = uc)
  355.                                         AND (mess_work^.mess_lang > lang_num));
  356.                               DELAY(1000);
  357.                             END;
  358.                         {$ENDIF}
  359.  
  360.                       UNTIL (mess_work = NIL)
  361.                             OR (mess_work^.mess_class < uc)
  362.                             OR ((mess_work^.mess_class = uc)
  363.                                         AND (mess_work^.mess_lang < lang_num));
  364.  
  365.                       IF (mess_work <> NIL)
  366.                                      AND (mess_work^.mess_class = uc)
  367.                                      AND (mess_work^.mess_lang = lang_num) THEN
  368.                         BEGIN;
  369.                           STR(line_cnt, s);
  370.                           send_err_mess(
  371.                             'Error in message file -- Duplicate -- line # '
  372.                             + s);
  373.                           GOTO read_loop;
  374.                         END;
  375.  
  376.                       {$IFDEF DEBUG_L1}
  377.                         IF message_no = 4 THEN
  378.                           BEGIN;
  379.                             WRITELN('Insert -- ', ORD(uc), ' -- ', lang_num);
  380.                             WRITELN('Before -- ', ORD(mess_work^.mess_class),
  381.                                           ' -- ', mess_work^.mess_lang);
  382.                             WRITELN('After  -- ', ORD(mess_old^.mess_class),
  383.                                           ' -- ', mess_old^.mess_lang);
  384.                           END;
  385.                       {$ENDIF}
  386.  
  387.                       mess_old^.mess_next := mess_head;
  388.                       mess_head^.mess_next := mess_work;
  389.  
  390.                     END;
  391.  
  392.                 END
  393.               ELSE
  394.                 BEGIN;
  395.  
  396.                   (*---------------------------------------------------------*)
  397.                   (* Bad header format                                       *)
  398.                   (*---------------------------------------------------------*)
  399.  
  400.                   STR(line_cnt, s);
  401.                   send_err_mess(
  402.                     'Error in message file -- Bad header format -- line # '
  403.                     + s);
  404.                   GOTO read_loop;
  405.  
  406.                 END;
  407.             END
  408.           ELSE
  409.             BEGIN;
  410.  
  411.               (*-------------------------------------------------------------*)
  412.               (* Add a text line to the message                              *)
  413.               (*-------------------------------------------------------------*)
  414.  
  415.               IF message_no <> 0 THEN
  416.                 BEGIN
  417.  
  418.                   strip_var(in_str, 'T');
  419.  
  420.                   IF (LENGTH(in_str) = 1) AND (in_str[1] = '%') THEN
  421.                     in_str[1] := ' ';
  422.  
  423.                   IF LENGTH(in_str) > 0 THEN
  424.                     IF in_str[1] <> '@' THEN
  425.                       add_message_q(mess_head^.mess_this, FALSE, in_str)
  426.                     ELSE
  427.                       add_message_q(mess_head^.mess_this,
  428.                                                    TRUE, SUBSTR(in_str, 2, 0));
  429.  
  430.                 END;
  431.  
  432.             END;
  433.         END;
  434.  
  435.       (*---------------------------------------------------------------------*)
  436.       (* Close things up                                                     *)
  437.       (*---------------------------------------------------------------------*)
  438.  
  439.       CLOSE(mess_file);
  440.  
  441.     END;
  442.  
  443.   (*=========================================================================*)
  444.   (* Main line of message load                                               *)
  445.   (*=========================================================================*)
  446.  
  447.   BEGIN;
  448.  
  449.     (*-----------------------------------------------------------------------*)
  450.     (* Initialize things                                                     *)
  451.     (*-----------------------------------------------------------------------*)
  452.  
  453.     error_sw := FALSE;
  454.  
  455.     FOR i := 1 TO max_message DO
  456.       message_array[i] := NIL;
  457.  
  458.     i := LENGTH(opt_block.language_list);
  459.  
  460.     WHILE (i > 1) AND (NOT error_sw) DO
  461.       BEGIN;
  462.  
  463.         {$IFDEF DEBUG_L1}
  464.           WRITELN('MFload -- ', i, '--', opt_block.language_list[i]);
  465.         {$ENDIF}
  466.  
  467.         message_file_process(opt_block.language_list[i], i-1);
  468.  
  469.         DEC(i);
  470.  
  471.       END;
  472.  
  473.     IF NOT error_sw THEN
  474.       message_file_process(' ', 0);
  475.  
  476.     (*-----------------------------------------------------------------------*)
  477.     (* Abort on error                                                        *)
  478.     (*-----------------------------------------------------------------------*)
  479.  
  480.     IF error_sw AND error_abort THEN
  481.       BEGIN;
  482.         WRITELN('Fatal error in message file loading');
  483.         HALT;
  484.       END;
  485.  
  486.   END;
  487.  
  488. (*===========================================================================*)
  489. (* Reload message file                                                       *)
  490. (*===========================================================================*)
  491.  
  492. PROCEDURE message_reload;
  493.  
  494.   VAR
  495.     i          : WORD;
  496.     mess_inx   : BYTE;
  497.     next_mess  : mess_list_ptr;
  498.     next_qe    : qe_ptr;
  499.     work_mess  : mess_list_ptr;
  500.     work_qe    : qe_ptr;
  501.  
  502.   BEGIN;
  503.  
  504.     (*-----------------------------------------------------------------------*)
  505.     (* See if we can run.                                                    *)
  506.     (*-----------------------------------------------------------------------*)
  507.  
  508.     IF bbs_busy THEN
  509.       BEGIN;
  510.         send_message(message_other_active);
  511.         EXIT;
  512.       END;
  513.  
  514.     (*-----------------------------------------------------------------------*)
  515.     (* Obtain the interrupt lock                                             *)
  516.     (*-----------------------------------------------------------------------*)
  517.  
  518.     get_semaphore(semaphore_interrupts, sem_exclusive, FALSE);
  519.  
  520.     (*-----------------------------------------------------------------------*)
  521.     (* Tell user started                                                     *)
  522.     (*-----------------------------------------------------------------------*)
  523.  
  524.     window_write(active_tcb^.port_chan_s + '>:',
  525.                    'Reload is started -- All tasks are locked.  Please wait.');
  526.  
  527.     (*-----------------------------------------------------------------------*)
  528.     (* Unload the message lists                                              *)
  529.     (*-----------------------------------------------------------------------*)
  530.  
  531.     FOR mess_inx := 1 TO max_message DO
  532.       BEGIN;
  533.         next_mess := message_array[mess_inx];
  534.         WHILE next_mess <> NIL DO
  535.           BEGIN;
  536.  
  537.             {$IFDEF POINT_CHK}
  538.               test_pointer(next_mess);
  539.             {$ENDIF}
  540.  
  541.             work_mess := next_mess;
  542.             next_mess := work_mess^.mess_next;
  543.             next_qe   := work_mess^.mess_this;
  544.             WHILE next_qe <> NIL DO
  545.               BEGIN;
  546.  
  547.                 {$IFDEF POINT_CHK}
  548.                   test_pointer(next_qe);
  549.                 {$ENDIF}
  550.  
  551.                 work_qe := next_qe;
  552.                 next_qe := work_qe^.qe_next;
  553.  
  554.                 i       := WORD(qe_overhead) + LENGTH(work_qe^.qe_data);
  555.                 FREEMEM(work_qe, i);
  556.  
  557.                 {$IFDEF FREE_CHK}
  558.                   test_free_list;
  559.                 {$ENDIF}
  560.  
  561.               END;
  562.  
  563.             DISPOSE(work_mess);
  564.  
  565.             {$IFDEF FREE_CHK}
  566.               test_free_list;
  567.             {$ENDIF}
  568.  
  569.           END;
  570.       END;
  571.  
  572.     (*-----------------------------------------------------------------------*)
  573.     (* Reload                                                                *)
  574.     (*-----------------------------------------------------------------------*)
  575.  
  576.     message_init(FALSE);
  577.  
  578.     (*-----------------------------------------------------------------------*)
  579.     (* Do a task switch here to allow unblocked tasks to update              *)
  580.     (* Also verify time                                                      *)
  581.     (*-----------------------------------------------------------------------*)
  582.  
  583.     task_switch;
  584.     time_check;
  585.  
  586.     (*-----------------------------------------------------------------------*)
  587.     (* Release the interrupt lock                                            *)
  588.     (*-----------------------------------------------------------------------*)
  589.  
  590.     free_semaphore(semaphore_interrupts);
  591.  
  592.     (*-----------------------------------------------------------------------*)
  593.     (* Tell user done                                                        *)
  594.     (*-----------------------------------------------------------------------*)
  595.  
  596.     window_write(active_tcb^.port_chan_s + '>:', 'Reload is done');
  597.  
  598.   END;
  599.  
  600. END.
  601.